unit uDragManager;

interface
uses
  Classes,
  BaseClasses, GLHudObjects,
  GlObjects,
  GlRenderContextInfo,
  VectorGeometry,
  GLMaterial;
type
//------------------------------------------------------------------------------
  TDragTarget = class;
  TDragManager = class;
//------------------------------------------------------------------------------
  TBaseDrag = class
    fSprite: TGlHudSprite;
    fActionRect: TVector;
  public
    Procedure CopyFrom(aSource: TBaseDrag); virtual;
    Function GetActionRect: TVector;
    Function GetScreenActionRect: TVector;
    Procedure SetActionRect(aLeft, aTop, aRight, aBottom: Single); overload;
    Procedure SetActionRect(aVector: TVector); overload;
    Procedure CreateStandardSprite(aLibrary: TGlMaterialLibrary; aMaterialName: String);
    Destructor Destroy; override;
  end;
//------------------------------------------------------------------------------
  TDragList = class(TList)
  protected
    fManager: TDragManager;
  public
    Constructor Create(aManager: TDragManager);
    Function GetObjectByIndex(aIndex: Integer): TBaseDrag;
    Function GetObjectRect(aIndex: Integer): TVector;
    Function GetObjectByPos(aPos: TVector): TBaseDrag;
    Function PushObject(aObject: TBaseDrag): integer;
    Function AddObject(aObject: TBaseDrag; aPos: TVector; aMaterialName: String): integer;
  end;
//------------------------------------------------------------------------------
  TDragObject = class(TBaseDrag)
  protected
    fInTarget: TDragTarget;
    fCloning: Boolean;
  public
    property Cloning: Boolean read fCloning write fCloning;
    Procedure CopyFrom(aSource: TDragObject); reintroduce;
    Procedure SetPosition(aPosition: TVector);
    Procedure DragToTarget(aTarget: TDragTarget);
  end;
//------------------------------------------------------------------------------
  TDragTarget = class(TBaseDrag)
    fObjectInPlace: TDragObject;
  end;
//------------------------------------------------------------------------------
  TOnDragBaseEvent = procedure (aManager: TDragManager; aDragObject: TDragObject; aDragTarget: TDragTarget) of object;
  TOnDragProceedEvent = procedure (aManager: TDragManager; aDragObject: TDragObject; aDragTarget: TDragTarget; aPreviousTarget: TDragTarget) of object;
//------------------------------------------------------------------------------
  TDragManager = class (TGlDummyCube)
  protected
    fTargets: TDragList;
    fObjects: TDragList;

    fLButtonDown: Boolean;
    fDragingObject: TDragObject;
    fDragingPos: TVector;
    fDragingStart: TVector;
    fMousePos: TVector;
    fCurrentTarget: TDragTarget;

    Function GetObjectByIndex(aIndex: Integer): TDragObject;
    Procedure SwapObjects(aTarget1, aTarget2: TDragTarget);
    Function DuplicateObject(aObject: TDragObject): TDragObject;
  protected
    fOnBeginDrag: TOnDragBaseEvent;
    fOnEndDrag: TOnDragProceedEvent;
    fOnDragProceed: TOnDragBaseEvent;
    fOnDragProceedTarget: TOnDragProceedEvent;
  public
    // on start drag
    property OnBeginDrag: TOnDragBaseEvent read fOnBeginDrag write fOnBeginDrag;
    // on end drag
    property OnEndDrag: TOnDragProceedEvent read fOnEndDrag write fOnEndDrag;
    // on moving drag-object
    property OnDragProceed: TOnDragBaseEvent read fOnDragProceed write fOnDragProceed;
    // on change target while dragging
    property OnDragProceedTarget: TOnDragProceedEvent read fOnDragProceedTarget write fOnDragProceedTarget;

    Procedure DeleteByObject(aObject: TDragObject; aFree: Boolean = false);
    
    Procedure DoRender(var ARci: TRenderContextInfo; ARenderSelf, ARenderChildren: Boolean); override;
    Procedure DoProgress(const progressTime: TProgressTimes); override;
    Procedure SetMousePos(aMousePos: TVector);

    Function AddDragObject(aPos: TVector; aMaterialName: String): TDragObject;
    Function AddDragTarget(aPos: TVector; aMaterialName: String): TDragTarget;
    Constructor Create(AOwner: TComponent); override;
  end;
//------------------------------------------------------------------------------
implementation
uses
  GLCoordinates,
  SysUtils, Windows, GlKeyboard, GLScene;
//------------------------------------------------------------------------------
Procedure TBaseDrag.CopyFrom(aSource: TBaseDrag);
begin
  fSprite := TGlHudSprite.CreateAsChild(aSource.fSprite.Parent);
  with aSource.fSprite.Material do
    CreateStandardSprite(MaterialLibrary, GetLibMaterial.Name);
  fSprite.Position.SetPoint(aSource.fSprite.Position.AsVector);
  SetActionRect(aSource.GetActionRect());
end;
//------------------------------------------------------------------------------
Function TBaseDrag.GetActionRect: TVector;
begin
  result := fActionRect;
end;
//------------------------------------------------------------------------------
Function TBaseDrag.GetScreenActionRect: TVector;
begin
  with fSprite do
  begin
    Result[0] := Position.X + fActionRect[0] * Width / 2;
    Result[1] := Position.Y + fActionRect[1] * Height / 2;
    Result[2] := Position.X + fActionRect[2] * Width / 2;
    Result[3] := Position.Y + fActionRect[3] * Height / 2;
  end;
end;
//------------------------------------------------------------------------------
Procedure TBaseDrag.SetActionRect(aLeft, aTop, aRight, aBottom: Single);
begin
  fActionRect := VectorMake(aLeft, aTop, aRight, aBottom);
end;
//------------------------------------------------------------------------------
Procedure TBaseDrag.SetActionRect(aVector: TVector);
begin
  fActionRect := aVector;
end;
//------------------------------------------------------------------------------
Procedure TBaseDrag.CreateStandardSprite(aLibrary: TGlMaterialLibrary; aMaterialName: String);
begin
  SetActionRect(-1, -1, 1, 1);
  with fSprite do
  begin
    Material.MaterialLibrary := aLibrary;
    Material.LibMaterialName := aMaterialName;
    Width := Material.GetActualPrimaryTexture.Image.Width;
    Height := Material.GetActualPrimaryTexture.Image.Height;
  end;
end;
//------------------------------------------------------------------------------
Destructor TBaseDrag.Destroy; 
begin
  if fSprite <> nil then
    FreeAndNil(fSprite);
  inherited Destroy;
end;
//------------------------------------------------------------------------------
//------------------------------------------------------------------------------
//------------------------------------------------------------------------------
Constructor TDragList.Create(aManager: TDragManager);
begin
  inherited Create;
  fManager := aManager;
end;
//------------------------------------------------------------------------------
Function TDragList.GetObjectByIndex(aIndex: Integer): TBaseDrag;
begin
  result := TBaseDrag(Items[aIndex]);
end;
//------------------------------------------------------------------------------
Function TDragList.GetObjectRect(aIndex: Integer): TVector;
var
  Obj: TBaseDrag;
begin
  Obj := GetObjectByIndex(aIndex);
  if Obj <> nil then
    Result := Obj.GetScreenActionRect()
  else
    Result := VectorMake(0, 0, 0, 0);
end;
//------------------------------------------------------------------------------
Function TDragList.GetObjectByPos(aPos: TVector): TBaseDrag;
var
  i: integer;
  r: TVector;
begin
  result := nil;

  for i := 0 to Count - 1 do
  begin
    r := GetObjectRect(i);
    if(aPos[0] >= r[0]) and (aPos[1] >= r[1]) and
      (aPos[0] <= r[2]) and (aPos[1] <= r[3])then
    begin
      result := GetObjectByIndex(i);
      break;
    end;
  end;
end;
//------------------------------------------------------------------------------
Function TDragList.PushObject(aObject: TBaseDrag): integer;
begin
  result := Add(aObject);
end;
//------------------------------------------------------------------------------
Function TDragList.AddObject(aObject: TBaseDrag; aPos: TVector; aMaterialName: String): integer;
begin
  aObject.fSprite := TGlHudSprite.CreateAsChild(fManager);
  aObject.CreateStandardSprite(fManager.Material.MaterialLibrary, aMaterialName);
  aObject.fSprite.Position.SetPoint(aPos);
  result := PushObject(aObject);
end;
//------------------------------------------------------------------------------
//------------------------------------------------------------------------------
//------------------------------------------------------------------------------
Procedure TDragObject.CopyFrom(aSource: TDragObject);
begin
  inherited CopyFrom(aSource);
  fInTarget := aSource.fInTarget;
end;
//------------------------------------------------------------------------------
Procedure TDragObject.SetPosition(aPosition: TVector);
begin
  fSprite.Position.SetPoint(aPosition);
end;
//------------------------------------------------------------------------------
Procedure TDragObject.DragToTarget(aTarget: TDragTarget);
begin
  if aTarget <> nil then
  begin
    fSprite.Position.SetPoint(aTarget.fSprite.Position.AsVector);
    aTarget.fObjectInPlace := self;
  end;
  fInTarget := aTarget;
end;
//------------------------------------------------------------------------------
//------------------------------------------------------------------------------
//------------------------------------------------------------------------------
Procedure TDragManager.SetMousePos(aMousePos: TVector);
begin
  fMousePos := aMousePos;
end;
//------------------------------------------------------------------------------
Procedure TDragManager.DeleteByObject(aObject: TDragObject; aFree: Boolean = false);
begin
  if aObject = nil then
    exit;

  if aObject.fInTarget <> nil then
    aObject.fInTarget.fObjectInPlace := nil;
    
  if aObject = fDragingObject then
    fDragingObject := nil;
    
  fObjects.Remove(aObject);
  if aFree then
    FreeAndNil(aObject);
end;
//------------------------------------------------------------------------------
Function TDragManager.GetObjectByIndex(aIndex: Integer): TDragObject;
begin
  result := TDragObject(fObjects[aIndex]);
end;
//------------------------------------------------------------------------------
Procedure TDragManager.SwapObjects(aTarget1, aTarget2: TDragTarget);
var
  Obj: TDragObject;
begin
  Obj := aTarget1.fObjectInPlace;
  aTarget2.fObjectInPlace.DragToTarget(aTarget1);
  Obj.DragToTarget(aTarget2);
end;
//------------------------------------------------------------------------------
Function TDragManager.DuplicateObject(aObject: TDragObject): TDragObject;
begin
  result := TDragObject.Create;
  result.CopyFrom(aObject);
  fObjects.PushObject(result);
end;
//------------------------------------------------------------------------------
Procedure TDragManager.DoRender(var ARci: TRenderContextInfo; ARenderSelf, ARenderChildren: Boolean);
begin
  inherited;
end;
//------------------------------------------------------------------------------
Procedure TDragManager.DoProgress(const progressTime: TProgressTimes);
var
  Obj: TDragObject;
  Target: TDragTarget;
begin
  if IsKeyDown(VK_LBUTTON) and not fLButtonDown then
  begin
    Obj := TDragObject(fObjects.GetObjectByPos(fMousePos));
    fCurrentTarget := nil;
    // Click on DragObject
    if Obj <> nil then
    begin
      // Should clone it?
      if Obj.fCloning then
      begin
        fDragingObject := DuplicateObject(Obj);
        fDragingObject.Cloning := false;
      end
      else
        fDragingObject := Obj;
      // Save delta-position of click
      fDragingPos := VectorSubtract(Obj.fSprite.Position.AsVector, fMousePos);
      // Save position of Object
      fDragingStart := Obj.fSprite.Position.AsVector;
      // Render this object on top of other
      fDragingObject.fSprite.MoveLast;

      if Assigned(fOnBeginDrag) then
        fOnBeginDrag(self, fDragingObject, fDragingObject.fInTarget);
    end;
  end;

  if fDragingObject <> nil then
  begin
    fDragingObject.fSprite.Position.SetPoint(VectorAdd(fDragingPos, fMousePos));
    Target := TDragTarget(fTargets.GetObjectByPos(fMousePos));

    // call Proceed-event
    if Assigned(OnDragProceed) then
      OnDragProceed(self, fDragingObject, Target);

    // Does target change?
    if (fCurrentTarget <> Target) and Assigned(fOnDragProceedTarget) then
      fOnDragProceedTarget(self, fDragingObject, Target, fCurrentTarget);
    fCurrentTarget := Target;
  end;

  if not IsKeyDown(VK_LBUTTON) and (fDragingObject <> nil) then
  begin
    Target := TDragTarget(fTargets.GetObjectByPos(fMousePos));
    
    if Target <> nil then
    begin
      fDragingObject.fSprite.Position.SetPoint(Target.fSprite.Position.AsVector);

      if (Target.fObjectInPlace <> nil) then
      begin
        if fDragingObject.fInTarget <> nil then
          SwapObjects(fDragingObject.fInTarget, Target)
        else
        begin
          Target.fObjectInPlace.SetPosition(fDragingStart);
          Target.fObjectInPlace.fInTarget := nil;
          fDragingObject.DragToTarget(Target);
        end;
      end
      else if fDragingObject.fInTarget <> nil then
        fDragingObject.fInTarget.fObjectInPlace := nil;

      if fDragingObject <> nil then
        Target.fObjectInPlace := fDragingObject;
    end
    else if fDragingObject.fInTarget <> nil then
      fDragingObject.fInTarget.fObjectInPlace := nil;

    if fDragingObject <> nil then
    begin
      fCurrentTarget := fDragingObject.fInTarget;
      fDragingObject.fInTarget := Target;
    end
    else
      fCurrentTarget := nil;

    if Assigned(fOnEndDrag) then
      fOnEndDrag(self, fDragingObject, Target, fCurrentTarget);

    fDragingObject := nil;
    fCurrentTarget := nil;
  end;

  fLButtonDown := IsKeyDown(VK_LBUTTON);
end;
//------------------------------------------------------------------------------
Function TDragManager.AddDragObject(aPos: TVector; aMaterialName: String): TDragObject;
begin
  result := TDragObject.Create;
  result.fCloning := false;
  fObjects.AddObject(result, aPos, aMaterialName)
end;
//------------------------------------------------------------------------------
Function TDragManager.AddDragTarget(aPos: TVector; aMaterialName: String): TDragTarget;
begin
  result := TDragTarget.Create;
  fTargets.AddObject(result, aPos, aMaterialName)
end;
//------------------------------------------------------------------------------
Constructor TDragManager.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  fObjects := TDragList.Create(self);
  fTargets := TDragList.Create(self);
  fDragingObject := nil;
  fCurrentTarget := nil;
end;
//------------------------------------------------------------------------------
end.
